home *** CD-ROM | disk | FTP | other *** search
/ Gigarom 1 / Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso / FILES / DEV / I-Z / ViewIt™ Shareware.sea / ViewIt™ 2.04 Shareware / Projects / Pascal Demos / FaceProcLP.pas next >
Pascal/Delphi Source File  |  1992-06-24  |  3KB  |  122 lines
  1. {FaceWare 2.0 Initialization & Dispatching Procedures}
  2. {©FaceWare 1989-92.  All Rights Reserved.}
  3.  
  4. unit FaceProcLP;
  5.  
  6. interface
  7.  
  8.     uses
  9.         FaceStorLP;
  10.     type
  11.         HeadRec = record
  12.                 addr: ProcPtr;
  13.                 baseID: integer;
  14.                 versID: integer;
  15.                 message: integer;
  16.                 resID: integer;
  17.                 fPtr: Ptr;
  18.             end;
  19.         HeadPtr = ^HeadRec;
  20.     var
  21.         fRec: FaceRec;
  22.  
  23.     procedure FaceIt (thePtr: univ Ptr; m1, m2, m3, m4, m5: longint);
  24.  
  25. implementation
  26.  
  27.     procedure PrepIt (x, b, v, r, f: longint);
  28.         var
  29.             i: integer;
  30.     begin
  31.         with HeadPtr(x)^ do
  32.             begin
  33.                 addr := GetResource('FCMD', 1000)^;
  34.                 baseID := b;
  35.                 versID := v;
  36.                 message := 0;
  37.                 resID := r;
  38.                 fPtr := pointer(f);
  39.                 with fRec do
  40.                     if (xEntries > 0) then
  41.                         for i := 0 to xEntries - 1 do
  42.                             if (baseID = xTable[1 + i * 4]) then
  43.                                 if (versID = xTable[2 + i * 4]) then
  44.                                     if (xTable[4 + i * 4] <> 0) then
  45.                                         addr := ProcPtr(xTable[4 + i * 4]);
  46.             end;
  47.     end;
  48.  
  49.     procedure JumpIt (thePtr: Ptr);
  50.     inline
  51.         $2257, $2051, $4E90;
  52.  
  53.     procedure FaceIt;
  54.         var
  55.             i: integer;
  56.     begin
  57.         with fRec do
  58.             begin
  59.                 if (m1 = DoInit) then
  60.                     begin
  61.                         if (m4 > -1) and not BitTst(@m4, 31) then
  62.                             begin
  63.                                 FlushEvents(62, 0);        {ignore spurious mouse and key events}
  64.                                 InitGraf(@thePort);        {perform appropriate Mac initializations}
  65.                                 InitFonts;
  66.                                 InitWindows;
  67.                                 InitMenus;
  68.                                 TEInit;
  69.                                 InitDialogs(nil);
  70.                             end;
  71.                         if (GetResource('FCMD', 1000) = nil) then    {LoadIt available?}
  72.                             if (OpenResFile(StringPtr(StripAddress(@uName))^) < 0) then
  73.                                 ExitToShell;                                        {quit if not found}
  74.                         fFlags := m2;                                        {store FaceIt bit flags}
  75.                         xEntries := m5;                                    {store # of table entries}
  76.                         thePtr := @fRec;
  77.                         if (m3 > -1) then                                    {call LoadIt to expand heap?}
  78.                             begin
  79.                                 PrepIt(ord(thePtr), m3, 0, 0, ord(thePtr));
  80.                                 JumpIt(thePtr);
  81.                             end;
  82.                         PrepIt(ord(thePtr), 1100, 20, 0, ord(thePtr));        {setup fRec header}
  83.                         PrepIt(ord(@dHead), 1130, 10, 0, ord(thePtr));    {setup dRec header}
  84.                         PrepIt(ord(@uHead), 1110, 20, 0, ord(thePtr));    {setup uRec header}
  85.                         PrepIt(ord(@vHead), 1200, 20, 0, ord(thePtr));    {setup vRec header}
  86.                         fHead[6] := m4;                                    {store environment type}
  87.                         uHead[6] := 0;                                        {store string type}
  88.                         thePtr := nil;
  89.                         if (m4 < -3) then
  90.                             exit(FaceIt);
  91.                     end;
  92.                 if (m1 = DoPrep) then
  93.                     PrepIt(m2, m3, m4, m5, ord(@fRec))
  94.                 else if (m1 < 0) and (m1 > -11) then
  95.                     begin
  96.                         i := (4 * (-1 - m1));
  97.                         xTable[1 + i] := m2;
  98.                         xTable[2 + i] := m3;
  99.                         xTable[3 + i] := m4;
  100.                         xTable[4 + i] := m5;
  101.                     end
  102.                 else
  103.                     begin
  104.                         if (thePtr = nil) then        {call to the default module?}
  105.                             thePtr := @uHead
  106.                         else if (HeadPtr(thePtr)^.fPtr <> @fRec) then
  107.                             begin                            {call to a control driver?}
  108.                                 cControl := pointer(thePtr);
  109.                                 thePtr := @vHead;
  110.                             end;
  111.                         HeadPtr(thePtr)^.message := 0;
  112.                         uCommand := m1;                {pass Command & Params}
  113.                         uParam[1] := m2;
  114.                         uParam[2] := m3;
  115.                         uParam[3] := m4;
  116.                         uParam[4] := m5;
  117.                         JumpIt(thePtr);                {jump to FCMD module}
  118.                     end;
  119.             end;
  120.     end;
  121.  
  122. end.